Consignas

A partir del corpus deberán: * Cargar los datos * Preprocesarlos (normalizar texto, eliminar stopwords) * Generar una matriz token-por-fila para cada documento

A continuación deberán responder las siguientes preguntas:

Librerías

library(tidyverse) # Easily Install and Load the 'Tidyverse'
library(tidytext) # Text Mining using 'dplyr', 'ggplot2', and Other Tidy Tools
library(igraph) # Network Analysis and Visualization
library(ggraph) # An Implementation of Grammar of Graphics for Graphs and Networks
library(grid) # The Grid Graphics Package
library(topicmodels) # Topic Models
library(knitr) # A General-Purpose Package for Dynamic Report Generation in R
library(gganimate) # A Grammar of Animated Graphics

Datasets

Corpus de noticias “scrapeadas” entre julio y septiembre de 2019

raw_data <- read_csv("data/M5_corpus_medios.csv")
## Rows: 7000 Columns: 9
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr  (4): url, medio, titulo, texto
## dbl  (4): id, anio, mes, dia
## date (1): fecha
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

Exploramos rápidamente el dataset de noticias

# chequeo variables del dataset
names(raw_data)
## [1] "id"     "url"    "fecha"  "anio"   "mes"    "dia"    "medio"  "titulo"
## [9] "texto"
# vistazo rápido del dataset
raw_data %>% 
  head(10)
## # A tibble: 10 × 9
##       id url                     fecha       anio   mes   dia medio titulo texto
##    <dbl> <chr>                   <date>     <dbl> <dbl> <dbl> <chr> <chr>  <chr>
##  1 51960 https://www.clarin.com… 2019-07-01  2019     7     1 clar… "Copa… "Arg…
##  2 52024 https://www.clarin.com… 2019-07-01  2019     7     1 clar… "Robo… "La …
##  3 52023 https://www.clarin.com… 2019-07-01  2019     7     1 clar… "Inve… "La …
##  4 52095 http://luz.perfil.com/… 2019-07-01  2019     7     1 perf… "Arti… "Art…
##  5 51863 https://www.perfil.com… 2019-07-01  2019     7     1 perf… "Cier… "mar…
##  6 52087 https://exitoina.perfi… 2019-07-01  2019     7     1 perf… "Tele… "Con…
##  7 52084 https://www.clarin.com… 2019-07-01  2019     7     1 clar… "Vene… "Car…
##  8 51945 https://www.minutouno.… 2019-07-01  2019     7     1 minu… "La a… "El …
##  9 51928 https://www.clarin.com… 2019-07-01  2019     7     1 clar… "¿Mit… "Alg…
## 10 52375 https://www.clarin.com… 2019-07-01  2019     7     1 clar… "Los … "Hay…
# chequeo resumen del dataset
summary(raw_data)
##        id            url                fecha                 anio     
##  Min.   :    8   Length:7000        Min.   :2019-07-01   Min.   :2019  
##  1st Qu.:13006   Class :character   1st Qu.:2019-07-25   1st Qu.:2019  
##  Median :25648   Mode  :character   Median :2019-08-16   Median :2019  
##  Mean   :25990                      Mean   :2019-08-16   Mean   :2019  
##  3rd Qu.:39084                      3rd Qu.:2019-09-08   3rd Qu.:2019  
##  Max.   :52380                      Max.   :2019-09-29   Max.   :2019  
##                                     NA's   :84           NA's   :84    
##       mes             dia           medio              titulo         
##  Min.   :7.000   Min.   : 1.00   Length:7000        Length:7000       
##  1st Qu.:7.000   1st Qu.: 8.00   Class :character   Class :character  
##  Median :8.000   Median :15.50   Mode  :character   Mode  :character  
##  Mean   :8.028   Mean   :15.66                                        
##  3rd Qu.:9.000   3rd Qu.:24.00                                        
##  Max.   :9.000   Max.   :31.00                                        
##  NA's   :84      NA's   :84                                           
##     texto          
##  Length:7000       
##  Class :character  
##  Mode  :character  
##                    
##                    
##                    
##

Limpieza inicial

En esta primer exploración de las 10 primeras filas del dataset de noticias, podemos identificar algunos artículos que no se han descargado correctamente (por el proceso scrapeador). Como primer medida vamos a quitar estos registros

raw_data_clean <- raw_data %>% 
  filter(!str_detect(texto, "404 Client Error"))

raw_data_clean
## # A tibble: 6,976 × 9
##       id url                     fecha       anio   mes   dia medio titulo texto
##    <dbl> <chr>                   <date>     <dbl> <dbl> <dbl> <chr> <chr>  <chr>
##  1 51960 https://www.clarin.com… 2019-07-01  2019     7     1 clar… "Copa… "Arg…
##  2 52024 https://www.clarin.com… 2019-07-01  2019     7     1 clar… "Robo… "La …
##  3 52023 https://www.clarin.com… 2019-07-01  2019     7     1 clar… "Inve… "La …
##  4 51863 https://www.perfil.com… 2019-07-01  2019     7     1 perf… "Cier… "mar…
##  5 52087 https://exitoina.perfi… 2019-07-01  2019     7     1 perf… "Tele… "Con…
##  6 52084 https://www.clarin.com… 2019-07-01  2019     7     1 clar… "Vene… "Car…
##  7 51945 https://www.minutouno.… 2019-07-01  2019     7     1 minu… "La a… "El …
##  8 51928 https://www.clarin.com… 2019-07-01  2019     7     1 clar… "¿Mit… "Alg…
##  9 52375 https://www.clarin.com… 2019-07-01  2019     7     1 clar… "Los … "Hay…
## 10 52188 https://www.clarin.com… 2019-07-01  2019     7     1 clar… "Albe… "El …
## # … with 6,966 more rows

De esta manera se redujo el tamaño a 6976 filas.

Además observando el summary de los datos, podemos notar que la variable fecha contiene varios NA’s. También filtraremos estos casos.

raw_data_clean <- raw_data_clean %>% 
  filter(!is.na(fecha))

raw_data_clean
## # A tibble: 6,894 × 9
##       id url                     fecha       anio   mes   dia medio titulo texto
##    <dbl> <chr>                   <date>     <dbl> <dbl> <dbl> <chr> <chr>  <chr>
##  1 51960 https://www.clarin.com… 2019-07-01  2019     7     1 clar… "Copa… "Arg…
##  2 52024 https://www.clarin.com… 2019-07-01  2019     7     1 clar… "Robo… "La …
##  3 52023 https://www.clarin.com… 2019-07-01  2019     7     1 clar… "Inve… "La …
##  4 51863 https://www.perfil.com… 2019-07-01  2019     7     1 perf… "Cier… "mar…
##  5 52087 https://exitoina.perfi… 2019-07-01  2019     7     1 perf… "Tele… "Con…
##  6 52084 https://www.clarin.com… 2019-07-01  2019     7     1 clar… "Vene… "Car…
##  7 51945 https://www.minutouno.… 2019-07-01  2019     7     1 minu… "La a… "El …
##  8 51928 https://www.clarin.com… 2019-07-01  2019     7     1 clar… "¿Mit… "Alg…
##  9 52375 https://www.clarin.com… 2019-07-01  2019     7     1 clar… "Los … "Hay…
## 10 52188 https://www.clarin.com… 2019-07-01  2019     7     1 clar… "Albe… "El …
## # … with 6,884 more rows
summary(raw_data_clean)
##        id            url                fecha                 anio     
##  Min.   :    8   Length:6894        Min.   :2019-07-01   Min.   :2019  
##  1st Qu.:13051   Class :character   1st Qu.:2019-07-25   1st Qu.:2019  
##  Median :25648   Mode  :character   Median :2019-08-16   Median :2019  
##  Mean   :25985                      Mean   :2019-08-16   Mean   :2019  
##  3rd Qu.:39080                      3rd Qu.:2019-09-08   3rd Qu.:2019  
##  Max.   :52375                      Max.   :2019-09-29   Max.   :2019  
##       mes             dia           medio              titulo         
##  Min.   :7.000   Min.   : 1.00   Length:6894        Length:6894       
##  1st Qu.:7.000   1st Qu.: 8.00   Class :character   Class :character  
##  Median :8.000   Median :15.50   Mode  :character   Mode  :character  
##  Mean   :8.028   Mean   :15.66                                        
##  3rd Qu.:9.000   3rd Qu.:24.00                                        
##  Max.   :9.000   Max.   :31.00                                        
##     texto          
##  Length:6894       
##  Class :character  
##  Mode  :character  
##                    
##                    
##

Finalmente nos quedamos con 6894 registros.

Stopwords

A continuación vamos a cargar 2 listados de stopwords o palabras vacías

El primer listado proviene del libro online Cuentapalabras (Estilometría y análisis de texto con R para filólogos)

stopwords <- read_csv(
  "https://raw.githubusercontent.com/7PartidasDigital/AnaText/master/datos/diccionarios/vacias.txt",
  locale = default_locale(),
  col_names = c("word"))

y el segundo listado proviene de un repositorio y sus contribuciones a las stopwords en varios idiomas.

stopwords_extra <- read.delim(
  "https://raw.githubusercontent.com/Alir3z4/stop-words/master/spanish.txt", 
  col.names = c("word"))

y luego unimos ambos dataframes en un único listado de stopwords

stopwords_final <- bind_rows(stopwords, stopwords_extra) %>% 
  unique()

# y generamos un vector
stopwords_listado <- stopwords_final$word

EDA (Análisis Exploratorio de los Datos)

Vamos a realizar un análisis inicial para conocer un poquito mejor el dataset de noticias.

Análisis usando bigramas (y gráfos)

Vamos a realizar este análisis con todo el dataset (sin limpieza), esto para conocer de forma “aproximada” las distintas combinaciones de palabras que podemos encontrarnos en las noticias. Esto con la esperanza de detectar ciertos patrones que luego tendremos en cuenta en una segunda instancia de limpieza (quizás al remover stopwords). Por otra parte, puede resultar interesante visualizar la ocurrencia de bigramas en cada medio. Mediante la visualización suelen surgir patrones interesantes y que pueden influir en la toma de decisiones y en la formulación de conclusiones en un análisis.

bigramas <- raw_data %>%
  unnest_tokens(bigrama,
                texto,
                token = "ngrams",
                n = 2)

bigramas_separados <- bigramas %>%
  separate(bigrama,
           c("palabra1", "palabra2"),
           sep = " ")

bigramas_filtrados <- bigramas_separados %>%
  filter(!palabra1 %in% stopwords_listado,
         !palabra2 %in% stopwords_listado)

Veamos una visualización “clásica” de los bigramas (top 10 por medio)

top_bigramas_x_medio <- bigramas_filtrados %>%
  unite(bigrama, palabra1, palabra2, sep = " ") %>% 
  count(medio, bigrama, sort = TRUE)


top_bigramas_x_medio %>%
  mutate(medio = as.factor(medio)) %>%
  group_by(medio) %>%
  top_n(10, wt = n) %>%
  ggplot(aes(x = n, y = reorder_within(bigrama, n, medio))) +
  geom_col(aes(fill = medio), show.legend = FALSE) +
  geom_text(aes(label = n), hjust = -.1) +
  scale_y_reordered() +
  scale_x_continuous(expand = expansion(mult = c(0, .4))) +
  labs(y = NULL) +
  facet_wrap(vars(medio), scales = "free_y") +
  theme_minimal()

Ahora vamos a generar una función que genere gráfos por medio, es decir, a la función le pasamos un medio en particular, por ejemplo "clarin" y la función realizará el grafo correspondiente de los bigramas que mayormente ocurren en dicho medio.

generar_grafo <- function(medio, freq) {
  
  grafo <- bigramas_filtrados %>%
    filter(medio == medio) %>% 
    count(palabra1, palabra2, sort = TRUE) %>% 
    filter(n > freq) %>%
    graph_from_data_frame()
  
  
  ggraph(grafo, layout = "nicely") +
    geom_edge_link(aes(edge_alpha = n),
                   show.legend = FALSE,
                   arrow = arrow(type = "closed",
                                 length = unit(3, "mm"))) +
    geom_node_point(color = "lightblue", size = 3) +
    geom_node_text(aes(label = name), vjust = 1, hjust = 1) +
    theme_void() 
}

Nuestra función además recibe como parámetro el número de frecuencia mínimo de ocurrencia de bigramas.

Generemos el grafo para clarin

# grafo para "clarin"
generar_grafo("clarin", 150)

generemos el de pagina12

# grafo para "pagina12"
generar_grafo("pagina12", 150)

y finalmente veamos el grafo para minutouno

# grafo para minutouno"
generar_grafo("minutouno", 150)

Podemos observar que, con mayor fecuencia, aparecen números en “cadenas” del estilo “10 años”, “20 años”, etc, que denotan tiempo y probablemente no sean de nuestro interés. Además se nombran redes sociales (mail, twitter, facebook, etc) y fechas. Esto lo tendremos en cuenta para más adelante.

Enfoque tradicional (TF-IDF)

El estadístico tf-idf tiene como propósito medir la importancia de una palabra que ocurre en un documento, en una colección de documentos (o corpus), en nuestro caso, vamos a ver la “importancia que cada medio le da a cada palabra”. Notar que podríamos haber realizado este análisis para cada noticia, pero el objetivo en este caso será diferenciar por medio y finalmente este análisis contribuirá a serguir limpiando el dataset para luego hacer topic modeling.

# tokenizo
data_tokenizado <- raw_data %>% 
  unnest_tokens(word, texto)

palabras_medio <- data_tokenizado %>%
  count(medio, word, sort = TRUE)

palabras_medio <- palabras_medio %>% 
  bind_tf_idf(word, medio, n)

palabras_medio %>% 
  group_by(medio) %>% 
  slice_max(order_by = tf_idf, n = 10) %>% 
  ggplot(aes(x = tf_idf, y = reorder_within(word, tf_idf, medio))) +
  geom_col(aes(fill = medio), show.legend = FALSE) +
  #geom_text(aes(label = tf_idf), hjust = -.1) +
  # para ordenar las barras al interior de cada facet (se usa en conjunto con "reorder_within")
  scale_y_reordered() +
  # expandimos un poco a la derecha (40%) para que entre el texto de la barra
  scale_x_continuous(expand = expansion(mult = c(0, .4))) +
  guides(fill = "none") +
  facet_wrap(vars(medio), scales = "free_y") +
  labs(x = NULL, y = NULL) +
  theme_minimal() +
  theme(
    axis.text.x = element_blank(),
    panel.grid = element_blank()
  )

Podemos identificar algunas palabras que no quisieramos considerar en nuestro análisis, como por ejemplo, jpg, loading, hd, etc. Vamos a considerarlas para la limpieza definitiva del dataset.

Tokenización + limpieza de stopwords

Ahora vamos a proceder con el proceso de tokenización y luego con la limpieza de stopwords. Como vimos en el análisis de bigramas, en nuestros documentos existen números y vamos a removerlos de nuestro análisis. Además, pudimos identificar del enfoque “tradicional” tf-idf, algunas palabras que no deberían ser consideradas en nuestro análisis, por lo que vamos a removerlas.

mystopwords <- tibble(word = c("embed","jpg","loading","hd","protected",
                               "comentar","guardar","leé","minutouno","páginai","lxs",
                               "mirá","email","www"))

# tokenizo
data_tokenizado <- raw_data %>% 
  unnest_tokens(word, texto)

# limpieza definitiva
data_clean <- data_tokenizado %>%
  # removemos stopwords
  anti_join(stopwords_final) %>% 
  # "elimino" números
  mutate(word = str_extract(word, "[[:alpha:]]+")) %>%
  filter(!is.na(word)) %>% 
  # removemos algunas palabras detectadas "a mano"
  anti_join(mystopwords)
## Joining, by = "word"
## Joining, by = "word"

Un enfoque naive

Veamos rápidamente una forma de obtener el top 10 de palabras más utilizadas por cada medio en un mes en particular (usando el enfoque tf-idf). Para esto vamos a definir una función que nos permita pasarle el mes como argumento.

top_words_medio_mes <- function(mes_filter, n_top = 10){
  df <- data_clean %>%
    filter(mes == mes_filter) %>% 
    count(medio, word, sort = TRUE) %>% 
    bind_tf_idf(word, medio, n) %>% 
    group_by(medio) %>% 
    slice_max(order_by = tf_idf, n = n_top)
  
  df %>% 
    ggplot(aes(x = tf_idf, y = reorder_within(word, tf_idf, medio))) +
    geom_col(aes(fill = medio), show.legend = FALSE) +
    #geom_text(aes(label = tf_idf), hjust = -.1) +
    # para ordenar las barras al interior de cada facet (se usa en conjunto con "reorder_within")
    scale_y_reordered() +
    # expandimos un poco a la derecha (40%) para que entre el texto de la barra
    scale_x_continuous(expand = expansion(mult = c(0, .4))) +
    guides(fill = "none") +
    facet_wrap(vars(medio), scales = "free_y") +
    labs(x = NULL, y = NULL) +
    theme_minimal() +
    theme(
      axis.text.x = element_blank(),
      panel.grid = element_blank()
    )
}

Y ahora llamemos a nuestra función con algunas combinaciones. Veamos por ejemplo para el mes 7

top_words_medio_mes(7)

y veamos para el mes 9

top_words_medio_mes(9)

No hay mucho para destacar del resultado obtenido si únicamente nos enfocamos en la métrica de tf-idf por medio. Por esto vamos a realizar un análisis más avanzado usando topic modeling.

Topic modeling

A continuación vamos a hacer uso de un modelo LDA (del paquete topicmodels), el cual es un método para ajustar un modelo de tópicos.

LDA es uno de los algoritmos más cómunes para topic modeling y se guía por dos principios:

Vamos a dejar de lado la consideración del medio únicamente y ahora cada documento va a estar dentificado por una combinación del medio y el ID de la noticia.

Luego vamos a generar un modelo LDA para 6 tópicos. Por razones de eficiencia y debido a que es un proceso que demora bastante, vamos a guardar el modelo resultante para su posterior carga.

if (file.exists("model_LDA.rda")) {
  
  medios_lda <- readRDS("model_LDA.rda")
  
} else {
  cuenta_palabras <- data_clean %>% 
  unite(document, medio, id) %>% 
  count(document, word, sort = TRUE)

  medios_tdm <- cuenta_palabras %>% 
    cast_dtm(document, word, n)
  
  # 6 tópicos
  medios_lda <- LDA(medios_tdm, k = 6, control = list(seed = 42))
  medios_lda
  
  # guardamos el modelo (pesado!)
  saveRDS(medios_lda, "model_LDA.rda")
}

Observemos las palabras más “representativas” que el modelo identificó para cada tópico.

medios_temas <- tidy(medios_lda, matrix = "beta")

# top palabras en cada topico o tema
top_temas <- medios_temas %>% 
  group_by(topic) %>% 
  slice_max(beta, n = 10) %>% 
  ungroup() %>% 
  arrange(topic, -beta)

# Una forma de ver los términos más utilizados en cada tópico
as.data.frame(terms(medios_lda, 10))
##       Topic 1   Topic 2    Topic 3   Topic 4  Topic 5   Topic 6
## 1        país    equipo   gobierno      años     años  millones
## 2        años argentina      macri   policía     vida       año
## 3       trump   partido  fernández  justicia    gusta argentina
## 4  presidente      años presidente     causa     casa   dólares
## 5      unidos     final     frente      caso      día   mercado
## 6    gobierno      boca    alberto    fiscal historia      país
## 7    personas      copa  argentina    juicio    gente     pesos
## 8       mundo    fútbol  candidato    ciudad    mujer    ciento
## 9     acuerdo     river       país      juez  familia      años
## 10    mujeres      club   política seguridad    mundo  empresas
top_temas %>%
  mutate(term = reorder_within(term, beta, topic)) %>%
  ggplot(aes(beta, term, fill = factor(topic))) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~ topic, scales = "free") +
  scale_y_reordered()

Perfecto! podemos identificar de que cosa trata cada tema o tópic y de esta manera vamos a construir un diccionario de tópicos en donde:

topicos <- data.frame(
  topic = c(1,2,3,4,5,6),
  valor = c("Internacionales",
            "Deporte/Fútbol",
            "Política",
            "Policial/Judicial",
            "Sociales/Entretenimiento",
            "Economía")
)

A continuación vamos a generar un dataset que utilize la métrica gamma, que nos indica la probabilidad de un documento de pertenecer a cada tópico o tema.

Además construiremos el dataset de tal manera que podamos identificar los tópicos que predominan en cada medio y en cada fecha.

En primer lugar vamos a obtener el medio y el ID que codificamos en la variable document

medios_temas <- tidy(medios_lda, matrix = "gamma")

# veamos la estructura inicial del dataset
head(medios_temas)
## # A tibble: 6 × 3
##   document       topic     gamma
##   <chr>          <int>     <dbl>
## 1 clarin_38104       1 0.768    
## 2 telam_29686        1 0.0000156
## 3 clarin_4969        1 0.0000443
## 4 lanacion_27049     1 0.0615   
## 5 clarin_3614        1 0.0000292
## 6 infobae_45627      1 0.0641
# obtenemos medio e ID de la noticia
medios_temas <- medios_temas %>% 
  separate(document, into = c("medio", "id"))

# veamos la estructura final del dataset
head(medios_temas)
## # A tibble: 6 × 4
##   medio    id    topic     gamma
##   <chr>    <chr> <int>     <dbl>
## 1 clarin   38104     1 0.768    
## 2 telam    29686     1 0.0000156
## 3 clarin   4969      1 0.0000443
## 4 lanacion 27049     1 0.0615   
## 5 clarin   3614      1 0.0000292
## 6 infobae  45627     1 0.0641

Ahora vamos a obtener la fecha de cada noticia, a partir del dataset inicial

medios_temas_fecha <- medios_temas %>%
  # para que coincida el tipo de "id" en cada df
  mutate(id = as.double(id)) %>% 
  left_join(raw_data_clean %>% select(id, fecha, mes, dia, texto))
## Joining, by = "id"
head(medios_temas_fecha)
## # A tibble: 6 × 8
##   medio       id topic     gamma fecha        mes   dia texto                   
##   <chr>    <dbl> <int>     <dbl> <date>     <dbl> <dbl> <chr>                   
## 1 clarin   38104     1 0.768     2019-07-27     7    27 "En la fábrica de alime…
## 2 telam    29686     1 0.0000156 2019-08-10     8    10 "Las provincias que def…
## 3 clarin    4969     1 0.0000443 2019-09-21     9    21 "La ex presidenta Crist…
## 4 lanacion 27049     1 0.0615    2019-08-14     8    14 "El Harlem Cultural Fes…
## 5 clarin    3614     1 0.0000292 2019-09-24     9    24 "Detalles y servicios e…
## 6 infobae  45627     1 0.0641    2019-07-13     7    13 "Robert James Fischer, …

Genial! ahora tenemos un dataset con el valor de **gamma* para cada noticia por medio y por fecha.

Probemos algunas visualizaciones sencillas.

visualización de tópicos “global” por medio

# para cada medio obtenemos los tópicos que suceden con mayor frecuencia
topicos_medio <- medios_temas_fecha %>% 
  group_by(medio, id) %>% 
  top_n(1, wt = gamma)

topicos_medio %>% 
  group_by(medio, topic) %>% 
  summarise(
    total = n()
  ) %>% 
  mutate(pct = total / sum(total)) %>% 
  left_join(topicos) %>% 
  ggplot(aes(y = reorder_within(valor, pct, medio), 
             x = pct,
             fill = medio)) +
  geom_col(show.legend = FALSE) +
  labs(y = NULL) +
  facet_wrap(~ medio, scales = "free") +
  scale_y_reordered()
## `summarise()` has grouped output by 'medio'. You can override using the
## `.groups` argument.
## Joining, by = "topic"

De esta manera podemos observar para cada medio, qué tópico o tema predomina mayormente.

Veamos la misma información pero ahora usando otro tipo de viz.

library(ggradar) # Create radar charts using ggplot2

df_radar <- medios_temas_fecha %>% 
  group_by(medio, id) %>% 
  top_n(1, wt = gamma) %>% 
  group_by(medio, topic) %>% 
  summarise(
    total = n()
  ) %>% 
  mutate(pct = total / sum(total)) %>% 
  left_join(topicos) %>% 
  select(medio, topic = valor, pct) %>% 
  pivot_wider(
    names_from = topic,
    values_from = pct
  )
## `summarise()` has grouped output by 'medio'. You can override using the
## `.groups` argument.
## Joining, by = "topic"
plot_radar_medio <- function(medio_f){
  df_radar_filter <- df_radar %>% 
    filter(medio == medio_f)
  
  ggradar(df_radar_filter)
}

Veamos el gráfico para “clarin”

plot_radar_medio("clarin")

Podemos observar que existen un mayor (pero no tanto) porcentaje de noticias de “Economía”.

Y veamos ahora el gráfico para “cronica”

plot_radar_medio("cronica")

Acá es notable que las noticias del medio “cronica” son mayormente de tema “Policial/Judicial”.

Variación de tópicos por fecha

Veamos cómo varían los tópicos para cada medio por fecha. Para esto vamos a escribir una función que dado un medio, genere una visualización animada.

generar_plot_animado <- function(medio_f) {
  anim <- medios_temas_fecha %>% 
    filter(medio == medio_f) %>% 
    group_by(id) %>% 
    top_n(1, wt = gamma) %>%
    ungroup() %>% 
    left_join(topicos) %>%
    group_by(fecha, valor) %>% 
    summarise(
      total = n()
    ) %>% 
    mutate(Rank = rank(total, ties.method = "first")) %>% 
    mutate(Rank = as.factor(Rank)) %>% 
    mutate(pct = total / sum(total)) %>% 
    mutate(valor = as.factor(valor)) %>% 
    arrange(fecha, pct) %>% 
    ggplot() +
    geom_col(aes(
      x = fct_reorder(Rank, pct),
      y = pct,
      fill = valor,
      group = valor
    ), width = .7) +
    geom_text(aes(
      x = fct_reorder(Rank, pct), 
      y = 0,
      label = valor, group = valor), 
      hjust = 0,
      size = 7) +
    scale_y_continuous(labels = scales::percent_format()) +
    coord_flip(clip = "off") +
    labs(y = NULL) +
    guides(fill = "none") +
    theme_minimal() +
    theme(
      axis.text.y = element_blank(),
      axis.title.y = element_blank(),
      axis.text.x = element_text(size = 12),
      axis.title.x = element_text(size = 13),
      plot.title = element_text(size = 18)
    ) +
    # Animamos la VIZ
    ggtitle('Mostrando tópicos para {medio_f} en fecha: {closest_state}') +
    transition_states(fecha, state_length = 0, transition_length = 2) +
    enter_fly(x_loc = 0, y_loc = 0) +
    exit_fly(x_loc = 0, y_loc = 0) + 
    ease_aes('quadratic-in-out') 
    
  animate(anim, width = 700, height = 500, 
        fps = 25, duration = 60, rewind = FALSE)
}
generar_plot_animado("clarin")
## Joining, by = "topic"
## `summarise()` has grouped output by 'fecha'. You can override using the
## `.groups` argument.
## Warning in lapply(row_vars$states, as.integer): NAs introducidos por coerción

## Warning in lapply(row_vars$states, as.integer): NAs introducidos por coerción
## Warning in expand_panel(..., self = self): NAs introducidos por coerción

## Warning in expand_panel(..., self = self): NAs introducidos por coerción

Visualización general de evolución de tópicos por fecha

 medios_temas_fecha %>% 
    group_by(id) %>% 
    top_n(1, wt = gamma) %>%
    mutate(mes = lubridate::floor_date(fecha, 'month')) %>% 
    group_by(mes, medio, topic) %>% 
    summarise(
      total = n()
    ) %>% 
    mutate(pct = total / sum(total)) %>% 
    left_join(topicos) %>% 
    ggplot(aes(x = mes, y = pct, fill = valor)) +
    geom_area(alpha = .6) +
    labs(y = NULL) +
    scale_x_date(date_breaks = "1 month", date_labels = "%b") +
    scale_y_continuous(labels = scales::percent_format()) +
    scale_fill_discrete(name = "Tópico") +
    facet_wrap(vars(medio))
## `summarise()` has grouped output by 'mes', 'medio'. You can override using the
## `.groups` argument.
## Joining, by = "topic"
## Warning: Removed 34 rows containing non-finite values (`stat_align()`).